(defun make-env (lsymb lval env)
  (if (atom lsymb)
  	;si 1 seule variable
    (if (atom lval)
	  ;si 1 seule valeur
	  env
	  ;si plusieurs valeurs
	  (error "make-env : trop d'arguments : ~s" lval))

	;si plusieurs variables
    (if (atom lval)
	  ;si 1 seule valeur
	  (error "make-env : pas assez d'arguments pour ~s" lsymb)
	  ;si plusieurs valeurs
	  (if (= (length lsymb) (length lval)) 
      	(make-env (cdr lsymb) 
				  (cdr lval) 
				  (acons (car lsymb) (car lval) env))
		(error "make-env : la taille de ~a ne correspond pas a celle de ~b" lsymb lval)
		)
	  )
	)
  )

(defmacro get-defun (symb)
  `(get ,symb :defun))

(defun meval (expr env)
  (cond 
  	;constante
  	((and (atom expr) (constantp expr))
	 	 expr)
	
	;variable
	((symbolp expr)
	 	 (let ((cell (assoc expr env)))
	   	   (if cell
	       	 (cdr cell)
	     	 (error "meval : ~s n'est pas un symbole" expr))))

	((and (consp (car expr)) ;si liste
	  	  (eq (caar expr) 'lambda)) ;si 1er elmt == lambda
 	 (meval-body (cddar expr) ;
		     	 (make-env (cadar expr)
			       	   	   (meval-args (cdr expr) env)
			       	   	   env)))

	;quote
	((eq 'quote (car expr)) (cadr expr))

	;if then else
	((eq 'if (car expr))
	 (if (meval (cadr expr) env)
	   (meval (caddr expr) env)
	   (meval (cadddr expr) env)))

	;let
	((eq 'let (car expr))
	 (meval-let (cadr expr)
		    	(cddr expr)
		    	env))

	;progn
	((eq 'progn (car expr))
	 (progn (cdr expr)))

	;fonction
	((get-defun (car expr))
	 (let ((fun (get-defun (car expr))))
	   (meval-body (cddr fun)
		       	   (make-env (cadr fun)
				 			 (meval-args (cdr expr) env)
				 			 nil))))

	((not (fboundp (car expr)))
	 (error "~S est une fonction inconnue." (car expr)))

	;defun
	((eq 'defun (car expr))
	 (setf (get-defun (cadr expr))
	       `(lambda ,@(cddr expr))))

	((macro-function (car expr))
	 (meval (macroexpand-1 expr) env))

	;operateur classique
	((not (special-form-p (car expr)))
	 (apply (symbol-function (car expr)) 
	 		(meval-args (cdr expr) env) )
	 )

	(t
	  (error "meval : ~a incorrect" (car expr)))	
	)
  )

(defun meval-let (lvar lexpr env)
  (if (atom lvar)
    (meval-body lexpr env)
    (meval-let (cdr lvar) lexpr (acons (caar lvar) (cadar lvar) env))))

(defun meval-args (l-expr env)
  (if (atom l-expr)
    nil
    (cons (meval (car l-expr) env) 
	  	  (meval-args (cdr l-expr) env))))

(defun meval-body (l-expr env)
  (if (atom l-expr)
    nil
    (if (atom (cdr l-expr))
	  (meval (car l-expr) env)
      (progn 
		(meval (car l-expr) env)
		(meval-body (cdr l-expr) env)
		)
	  )
	)
  )

;FONCTIONS POUR TEST
;fibo
(defun fibo (n)
  (if (< n 2)
    1
    (+ (fibo (- n 1)) (fibo (- n 2)))))

;test de quote, let, car et cadr (retourne 20 * (x + y))
(defun test1 (x y)
  (let ((z '(2 10)))
  	(* 
	  (* 
	  	(+ x y) 
		(car z))
	  (cadr z))
	)
  )

;test de lambda
(defun test2 (x y)
  ((lambda (a b)
  	 (+ a b))
   x y)
  )

